Rob Bennetto and Eckhard Briedenhann
2019-04-06
What do we wear?
How do we fit it in with all of our other responsibilities?
What do we need?
Process:
Directed Acyclic Graphs (aka DAG)
Nodes:
nodes <- list(n1 = list(id = 1),
n2 = list(id = 2),
n3 = list(id = 3),
n4 = list(id = 4))
Helper functions:
getNodeID <- function(node){
paste0("n",node$id)
}
Vectorised Graph:
graph <- data.frame(From = c(1,1,2,3),
To = c(2,3,4,4))
From To
1 1 2
2 1 3
3 2 4
4 3 4
List Graph:
graph <- list()
graph[[getNodeID(n1)]] <- list(n2,n3)
graph[[getNodeID(n2)]] <- list(n4)
graph[[getNodeID(n3)]] <- list(n4)
$n1
$n1[[1]]
$n1[[1]]$id
[1] 2
$n1[[2]]
$n1[[2]]$id
[1] 4
$n2
$n2[[1]]
$n2[[1]]$id
[1] 4
$n4
$n4[[1]]
$n4[[1]]$id
[1] 4
Object Orientated Programming:
Node Class:
// Vector object
class Node {
public:
Node(int id):id(id){}
int id;
};
Graph Class:
class DAG {
public:
DAG(int size) : adjList(size){}
void addEdge(Node* from, Node* to){
adjList[from->id].push_back(to);
}
std::vector<std::vector<*Node>> adjList;
};
In practice:
// Init nodes
Node n1(1);
Node n2(2);
Node n3(3);
// 1 --> 2 --> 3
graph.AddEdge(&n1, &n2);
graph.AddEdge(&n2, &n3);
S3 Classes:
n1 <- list(id = 1)
class(n1) <- "node"
print.node <- function(obj){
cat("Class:",class(obj),
"\nID:",obj$id)
}
print(n1)
Class: node
ID: 1
Benefits:
Overall: 5/10
S4 Classes:
node <- setClass("node", slots=list(id="numeric"))
n1 <- node(id = 1)
print.node <- function(obj){
cat("Class:",class(obj),
"\nID:",obj@id)
}
print(n1)
Class: node
ID: 1
Benefits:
@ instread of $)Overall 8/10
Reference Classes:
node <- setRefClass("nodeR", fields = list(id = "numeric"),
methods = list(
show = function(){
cat("Node\nID:",id,"\n")
}
))
n1 <- node(id = 1)
print(n1)
Node
ID: 1
Benefits:
Overall 10/10 !
Things to note:
Why worry?
Copying reference classes:
n1 <- node(id = 1)
n1
Node
ID: 1
Wrong way to copy:
n2 = n1
n2$id <- 2
n1
Node
ID: 2
Right way to copy:
n2 <- n1$copy()
n2$id <- 2
n1
Node
ID: 1
Create some reference classes.
g<-dag()
g$load_from_file('classic_bst')
g$plot()
g$plot_heirarchy()
g$plot_heirarchy(colorRootLeaves = T)
g$plot(colorRootLeaves = T)
g$plot_heirarchy(colorRootLeaves = T, turn = T)
g$close_graph()
g$plot_heirarchy(colorRootLeaves = T, turn = T)
We might be interested in a feature of the graph
g$shortest_path(g$root_nodes(), g$leaf_nodes())
g$plot_heirarchy(T, T, g$shortest_path(g$root_nodes(), g$leaf_nodes()))
g$plot_heirarchy(T, T, g$critical_path(g$root_nodes(), g$leaf_nodes()))
You're right, that was too quick. What just happened?
The stack:
g <- dag(vertexCount = 0)
awake <- g$newVertex(description = "Awake")
awake
State
Description: Awake
ID: 0
dressedA <- g$newVertex(description = "DressedA")
dressedA
State
Description: DressedA
ID: 1
dressedB <- g$newVertex(description = "DressedB")
dressedB
State
Description: DressedB
ID: 2
getDressedA <- g$createTransition(from = awake,to = dressedA, weight = 1, description = "Getting pretty")
getDressedA
Edge
Description: Getting pretty
Weight: 1
From:
State
Description: Awake
ID: 0
To:
State
Description: DressedA
ID: 1
getDressedB <- g$createTransition(from = awake,to = dressedB, weight = 0.5, description = "Getting cool")
State:
state <- setRefClass("vertex", fields = list(id = "numeric", description = "character"),
methods = list(
show = function(){
cat("State\nDescription:",description, "\nID:",id,"\n")
}
))
Transition:
transition <- setRefClass("edge", fields = list(from = "vertex", to = "vertex", weight = "numeric", description ="character"),
methods = list(
show = function(){
cat("Edge\nDescription:",description,"\nWeight:",weight, "\nFrom:\n")
from$show()
cat("To:\n")
to$show()
})
)
DAG:
adjList <- setRefClass("adjList", fields = list(adjs = "list"),
methods = list(
addEdge = function(e){
if(!("edge" %in% class(e))){
stop("Cannot add non edge class to adjacency list")
}
vName <- paste0("v",e$from$id)
adjs[[vName]] <<- c(adjs[[vName]],e$to$id)
cat("Edge Added")
},
show = function(){
vNames <- names(adjs)
for(vN in vNames){
cat("Vertex:",vN,"\n")
cat("Adjs:",adjs[[vN]],"\n")
}
}
)
)
dag <- setRefClass("dag", fields = list( vertices = "list", edges = "list", adjList = "adjList", vertexCount = "numeric"),
methods = list(
newVertex = function(description){
v <- state(id = vertexCount, description = description )
vertexCount <<- vertexCount + 1
vertices <<- c(vertices,v)
return(v)
},
createTransition = function(from, to, weight, description){
e <- transition(from = from, to = to, weight= weight, description = description)
edges <<- c(edges,e)
adjList$addEdge(e)
return(e)
}
))